Tract-level
HBI/PPI Affordability (real rate)
p1_grade_hbi <- function(x){
grade <- NA
grade <- dplyr::case_when(
x < 7 ~ "1. Good - <7%",
x >= 7 & x < 10 ~ "2. Fair - 7-10%",
x >= 10 ~ "3. Poor - >10%"
)
return(grade)
}
p1_grade_ppi <- function(x){
grade <- NA
grade <- dplyr::case_when(
x < 20 ~ "1. Good",
x >= 20 & x < 35 ~ "2. Fair",
x >= 35 ~ "3. Poor"
)
return(grade)
}
p1_grade_hbi_ppi <- function(x){
grade <- NA
grade <- dplyr::case_when(
x == "Low Burden" ~ "1. Good",
x == "Moderate-Low Burden" ~ "2. Fair",
x == "Moderate-High Burden" ~ "2. Fair",
x == "High Burden" ~ "3. Poor",
x == "Very High Burden" ~ "3. Poor"
)
return(grade)
}
P1_overall$Grade_PPI <- p1_grade_ppi(P1_overall$PPI)
P1_tract$Grade_PPI <- p1_grade_ppi(P1_tract$PPI)
P1_overall$Grade_HBI <- p1_grade_hbi(P1_overall$HBI_size_avg)
P1_tract$Grade_HBI <- p1_grade_hbi(P1_tract$HBI_size_avg)
P1_overall$Grade_AFF <- p1_grade_hbi_ppi(P1_overall$HBI_size_avg)
P1_tract$Grade_AFF_avg <- p1_grade_hbi_ppi(P1_tract$aff_grade_avg)
P1_tract$Grade_AFF_1 <- p1_grade_hbi_ppi(P1_tract$aff_grade_1)
P1_tract$Grade_AFF_2 <- p1_grade_hbi_ppi(P1_tract$aff_grade_2)
P1_tract$Grade_AFF_3 <- p1_grade_hbi_ppi(P1_tract$aff_grade_3)
P1_tract$Grade_AFF_4 <- p1_grade_hbi_ppi(P1_tract$aff_grade_4)
P1_tract$Grade_AFF_5 <- p1_grade_hbi_ppi(P1_tract$aff_grade_5)
P1_tract$Grade_AFF_6 <- p1_grade_hbi_ppi(P1_tract$aff_grade_6)
P1_tract$Grade_AFF_7 <- p1_grade_hbi_ppi(P1_tract$aff_grade_7)
Both overall and across all census tracts, the affordability of water and sewer in Naperville can be characterized as “Good”. Naperville is the wealthiest community in the Midwest, so this might be expected. The median household income of Naperville is ~ $125,000, and the upper limit of the lowest quintile is ~$68,000 with a population with income <200% of the FPL of 5.2%. Compare to ~ $62,000, ~$22,000 and 29.5% for Chicago, IL. For the purposes of demonstrating the descriptive capabilities of the indicator, we construct an alternative HBI/PPI indicator by tripling both the PPI and HBI within Naperville census tracts across the board.
HBI/PPI Demonstrative Alternative
P1_overall$HBI_alt <- 3 * P1_overall$HBI_size_avg
P1_overall$PPI_alt <- 3 * P1_overall$PPI
P1_tract$PPI_alt <- 3 * P1_tract$PPI
P1_tract$HBI_alt <- 3 * P1_tract$HBI_size_avg
P1_overall$Grade_PPI_alt <- p1_grade_ppi(P1_overall$PPI_alt)
P1_tract$Grade_PPI_alt <- p1_grade_ppi(P1_tract$PPI_alt)
P1_overall$Grade_HBI_alt <- p1_grade_hbi(P1_overall$HBI_alt)
P1_tract$Grade_HBI_alt <- p1_grade_hbi(P1_tract$HBI_alt)
P1_overall$Grade_AFF_alt <- p1_grade_hbi_ppi(gradeAffordability(P1_overall$HBI_alt,P1_overall$PPI_alt))
P1_tract$Grade_AFF_alt <- p1_grade_hbi_ppi(gradeAffordability(P1_tract$HBI_alt,P1_tract$PPI_alt))
Below on the left we visualize the HBI, PPI, and overall grade using real data, and on the right with the demonstrated alternative data (applying Chicago’s income and poverty distributions to Naperville). A similar layout could be used for a user to compare the affordability metrics associated with an existing rate structure with a user-inputted rate structure.
m <- P1_tract %>% select(GEOID,NAME,PPI,Grade_PPI,PPI_alt,Grade_PPI_alt,
HBI_size_avg,Grade_HBI,HBI_alt,Grade_HBI_alt,
Grade_AFF_avg, Grade_AFF_alt)
m_ppi <- mapview::mapview(m,zcol="PPI",layer.name="PPI") + mapview::mapview(b,alpha.regions=0,col.regions="red",stroke=TRUE,lwd=3,color="red",layer.name="Municipal Boundary")
m_ppi_alt <- mapview::mapview(m,zcol="PPI_alt",layer.name="Demo PPI") + mapview::mapview(b,alpha.regions=0,col.regions="red",stroke=TRUE,lwd=3,color="red",layer.name="Municipal Boundary")
m_hbi <- mapview::mapview(m,zcol="HBI_size_avg",layer.name="HBI") + mapview::mapview(b,alpha.regions=0,col.regions="red",stroke=TRUE,lwd=3,color="red",layer.name="Municipal Boundary")
m_hbi_alt <- mapview::mapview(m,zcol="HBI_alt",layer.name="Demo HBI") + mapview::mapview(b,alpha.regions=0,col.regions="red",stroke=TRUE,lwd=3,color="red",layer.name="Municipal Boundary")
m_aff <- mapview::mapview(m,zcol="Grade_AFF_avg",layer.name="Affordability Grade",col.regions=brewer.pal(3,"Dark2")) + mapview::mapview(b,alpha.regions=0,col.regions="red",stroke=TRUE,lwd=3,color="red",layer.name="Municipal Boundary")
m_aff_alt <- mapview::mapview(m,zcol="Grade_AFF_alt",layer.name="Demo Affordability Grade", col.regions=brewer.pal(3,"Dark2")) + mapview::mapview(b,alpha.regions=0,col.regions="red",stroke=TRUE,lwd=3,color="red",layer.name="Municipal Boundary")
map1 <- sync(m_ppi,m_ppi_alt,m_hbi,m_hbi_alt,m_aff,m_aff_alt)
map1
Delinquency Rate
To set Delinquency grade thresholds, we take data from the AWWA Benchmarking database and set them to the interquartile range:
- Good: < 2.5%
- Fair: 2.5% - 14%
- Poor: > 14%
P1_tract$Delinquency_rate <- P1_tract$Cutoff_Perc*3.1
P1_tract <-
P1_tract %>%
mutate(Grade_delinquency = case_when(
Delinquency_rate < 2.5 ~ "1. Good - <2.5%",
Delinquency_rate >= 2.5 & Delinquency_rate <= 14 ~ "2. Fair - 2.5-14%",
Delinquency_rate > 14 ~ "3. Poor - >14%"
))
map2 <- select(P1_tract,NAME,GEOID,HBI_size_avg,PPI,aff_grade_avg, Delinquency_rate, Grade_delinquency)
mapview::mapview(map2,zcol="Grade_delinquency",
layer.name="Delinquency (%) Grade",
col.regions=brewer.pal(2,"Dark2"))
## Warning in brewer.pal(2, "Dark2"): minimal value for n is 3, returning requested palette with 3 different levels
Cutoff Rate
To set cutoff grade thresholds, we need to examine a real-world distribution of cutoff rates, which are not included in the AWWA Benchmarkind data. CA collects cutoff rate information for the Electronic Annual Report process. Below, we see that at least in CA, 25% of utilities had no shutoffs at all, while another 20% of utilities had shutoff rates between 0% and 1%. We might wish to set “0” or “1%” as the “Good” category. There are some discontinuities evident at around a shutoff rate of 10% (7% of utilities were above that) and 15% (4% of utilities above that), which we might take as our boundary between “Fair” and “Poor” cutoff performance. This would be better tuned with more nationally representative data, but as a first cut:
- Good: <1%
- Fair: 1-10%
- Poor: >10%
#nothing
load("../data/cal-data.rds")
ggplot(D, aes(shutoffs_perc*100)) +
geom_rect(mapping=aes(xmin=0,ymin=0,xmax=1,ymax=1), fill="green", alpha=0.5) +
geom_rect(mapping=aes(xmin=1,ymin=0,xmax=10,ymax=1), fill="orange", alpha=0.5) +
geom_rect(mapping=aes(xmin=10,ymin=0,xmax=35,ymax=1), fill="red", alpha=0.5) +
stat_ecdf(geom="step") +
geom_vline(xintercept=1) +
geom_vline(xintercept=10) +
ylab("Cumulative proportion of utilities") +
xlab("Cutoff rate (%)")
## Warning: Removed 861 rows containing non-finite values (stat_ecdf).
Recall that we simulated shutoff rates, assuming this was related to HBI and PPI, which might be a plausible story. Below, we apply our shutoff grades.
P1_tract <-
P1_tract %>%
mutate(Grade_cutoff = case_when(
Cutoff_Perc < 1 ~ "1. Good - <1%",
Cutoff_Perc >= 1 & Cutoff_Perc < 10 ~ "2. Fair - 1-10%",
Cutoff_Perc >= 10 ~ "3. Poo - >10%r"
))
map2 <- select(P1_tract,NAME,GEOID,HBI_size_avg,PPI,aff_grade_avg, Cutoff_Perc, Grade_cutoff)
mapview::mapview(map2,zcol="Grade_cutoff",
layer.name="Cutoff (%) Grade",
col.regions=brewer.pal(2,"Dark2"))
## Warning in brewer.pal(2, "Dark2"): minimal value for n is 3, returning requested palette with 3 different levels
Customer Assistance Program participation
Participation should be measured as a proportion of “eligible” households. Here we set the eligible population as the proportion of families earning less than 200% of the FPL, although this in principle could be set on a utility-by-utility or utility-by-state basis with the appropriate eligibility criteria and estimates of this population. Based on previous participation reports from the CA Low-Income Rate Assistance Program, as well as the national LIHEAP program participation among this eligible population is generally between 0% and 40%, with an interquartile range of 11-22%. We can revise this to more “round” numbers of 10% and 25%.
- Good: >25%
- Fair: 10-25%
- Poor: <10%
We simulated this CAP participation rate, making assumptions related to certain demographic groups having lower participation rates than others, although most empirical evidence in the literature suggests this not to be a significant factor over the general level of outreach and application barriers to such programs. We apply the thresholds to create the 3-level grades below.
P1_tract$CAP_Percent <- (200/3)*P1_tract$CAP_Perc/P1_tract$PPI
P1_tract <-
P1_tract %>%
mutate(Grade_CAP = case_when(
CAP_Percent < 10 ~ "3. Poor - <10%",
CAP_Percent >= 10 & CAP_Percent < 25 ~ "2. Fair - 10-25%",
CAP_Percent >= 25 ~ "1. Good - >25%"
))
map3 <- select(P1_tract,NAME,GEOID,HBI_size_avg,PPI,aff_grade_avg, Cutoff_Perc, Grade_cutoff, CAP_Perc, Grade_CAP)
mapview::mapview(map3,zcol="Grade_CAP",layer.name="Garde of CAP Participation/PPI (%)", col.regions=brewer.pal(3,"Dark2"))
Appliance efficiency incentive participation rate
Annual participation in whole-home retrofit programs generally tops out at 3%, and individual appliance or irrigation/ field turf retrofits can vary between 0-20% or more. A first cut of thresholds:
- Good: >5%
- Fair: 1-5%
- Poor: <1%
set.seed(324324)
P1_tract$Incentive_rate <- rnorm(length(P1_tract$GEOID),2.5,1.5)
P1_tract <-
P1_tract %>%
mutate(Grade_incentive = case_when(
Incentive_rate < 1 ~ "3. Poor - <1%",
Incentive_rate >=1 & Incentive_rate < 5 ~ "2. Fair - 1-5% ",
Incentive_rate >= 5 ~ "1. Good - >5%"
))
m4 <- select(P1_tract, NAME,GEOID,Incentive_rate,Grade_incentive)
mapview::mapview(m4,zcol="Grade_incentive",layer.name="Incentive Participation grade",col.regions=brewer.pal(3,"Dark2"))
“Technical (service quality)” Complaints received/ 1,000 connections
The interquartile range for the 2018 version of the AWWA Benchmarking data for combined breaks and leaks can be used to set the ranges:
- Good: < 1.5
- Fair: 1.5 - 6.5
- Poor: > 6.5
set.seed(3242324)
P1_tract$complaint_per_conn <- rnorm(length(P1_tract$GEOID),
3.4,2.5)
P1_tract$complaint_per_conn[which(P1_tract$complaint_per_conn<0)]<-0
P1_tract <-
P1_tract %>%
mutate(Grade_complaint_per_conn =
case_when(
complaint_per_conn < 1.5 ~ "1. Good - <1.5 ",
complaint_per_conn >= 1.5 & complaint_per_conn < 6.5 ~ "2. Fair - 1.5-6.5",
complaint_per_conn >= 6.5 ~ "3. Poor - >6.5"
)
)
m5 <- select(P1_tract, NAME,GEOID,complaint_per_conn,Grade_complaint_per_conn)
mapview::mapview(m5,zcol="Grade_complaint_per_conn",layer.name="Complaint grade",col.regions=brewer.pal(3,"Dark2"))
% Complaints resolved
The interquartile range for the 2018 version of the AWWA Benchmarking data for combined breaks and leaks can be used to set the ranges:
- NA: No complaints
- Good: > 97%
- Fair: 91% - 97%
- Poor: < 91%
set.seed(3242324)
P1_tract$complaint_addressed_percent <- rnorm(length(P1_tract$GEOID),
95,3)
P1_tract$complaint_addressed_percent[which(P1_tract$complaint_per_conn==0)] <- NA
P1_tract <-
P1_tract %>%
mutate(Grade_complaint_addressed_percent =
case_when(
complaint_addressed_percent > 97 ~ "1. Good - >97%",
complaint_addressed_percent >= 91 & complaint_per_conn <= 97 ~ "2. Fair - 91-97%",
complaint_addressed_percent < 91 ~ "3. Poor - <91%"
)
)
m6 <- select(P1_tract, NAME,GEOID,complaint_addressed_percent,Grade_complaint_addressed_percent)
mapview::mapview(m6,zcol="Grade_complaint_addressed_percent",layer.name="Complaint grade",col.regions=brewer.pal(3,"Dark2"))